home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / generic / tkCmds.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  42.5 KB  |  1,647 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tkCmds.c --
  3.  *
  4.  *    This file contains a collection of Tk-related Tcl commands
  5.  *    that didn't fit in any particular file of the toolkit.
  6.  *
  7.  * Copyright (c) 1990-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tkCmds.c 1.125 97/05/20 16:16:33
  14.  */
  15.  
  16. #include "tkPort.h"
  17. #include "tkInt.h"
  18. #include <errno.h>
  19.  
  20. /*
  21.  * Forward declarations for procedures defined later in this file:
  22.  */
  23.  
  24. static TkWindow *    GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
  25. static char *        WaitVariableProc _ANSI_ARGS_((ClientData clientData,
  26.                 Tcl_Interp *interp, char *name1, char *name2,
  27.                 int flags));
  28. static void        WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
  29.                 XEvent *eventPtr));
  30. static void        WaitWindowProc _ANSI_ARGS_((ClientData clientData,
  31.                 XEvent *eventPtr));
  32.  
  33. /*
  34.  *----------------------------------------------------------------------
  35.  *
  36.  * Tk_BellCmd --
  37.  *
  38.  *    This procedure is invoked to process the "bell" Tcl command.
  39.  *    See the user documentation for details on what it does.
  40.  *
  41.  * Results:
  42.  *    A standard Tcl result.
  43.  *
  44.  * Side effects:
  45.  *    See the user documentation.
  46.  *
  47.  *----------------------------------------------------------------------
  48.  */
  49.  
  50. int
  51. Tk_BellCmd(clientData, interp, argc, argv)
  52.     ClientData clientData;    /* Main window associated with interpreter. */
  53.     Tcl_Interp *interp;        /* Current interpreter. */
  54.     int argc;            /* Number of arguments. */
  55.     char **argv;        /* Argument strings. */
  56. {
  57.     Tk_Window tkwin = (Tk_Window) clientData;
  58.     size_t length;
  59.  
  60.     if ((argc != 1) && (argc != 3)) {
  61.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  62.         " ?-displayof window?\"", (char *) NULL);
  63.     return TCL_ERROR;
  64.     }
  65.  
  66.     if (argc == 3) {
  67.     length = strlen(argv[1]);
  68.     if ((length < 2) || (strncmp(argv[1], "-displayof", length) != 0)) {
  69.         Tcl_AppendResult(interp, "bad option \"", argv[1],
  70.             "\": must be -displayof", (char *) NULL);
  71.         return TCL_ERROR;
  72.     }
  73.     tkwin = Tk_NameToWindow(interp, argv[2], tkwin);
  74.     if (tkwin == NULL) {
  75.         return TCL_ERROR;
  76.     }
  77.     }
  78.     XBell(Tk_Display(tkwin), 0);
  79.     XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
  80.     XFlush(Tk_Display(tkwin));
  81.     return TCL_OK;
  82. }
  83.  
  84. /*
  85.  *----------------------------------------------------------------------
  86.  *
  87.  * Tk_BindCmd --
  88.  *
  89.  *    This procedure is invoked to process the "bind" Tcl command.
  90.  *    See the user documentation for details on what it does.
  91.  *
  92.  * Results:
  93.  *    A standard Tcl result.
  94.  *
  95.  * Side effects:
  96.  *    See the user documentation.
  97.  *
  98.  *----------------------------------------------------------------------
  99.  */
  100.  
  101. int
  102. Tk_BindCmd(clientData, interp, argc, argv)
  103.     ClientData clientData;    /* Main window associated with interpreter. */
  104.     Tcl_Interp *interp;        /* Current interpreter. */
  105.     int argc;            /* Number of arguments. */
  106.     char **argv;        /* Argument strings. */
  107. {
  108.     Tk_Window tkwin = (Tk_Window) clientData;
  109.     TkWindow *winPtr;
  110.     ClientData object;
  111.  
  112.     if ((argc < 2) || (argc > 4)) {
  113.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  114.         " window ?pattern? ?command?\"", (char *) NULL);
  115.     return TCL_ERROR;
  116.     }
  117.     if (argv[1][0] == '.') {
  118.     winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
  119.     if (winPtr == NULL) {
  120.         return TCL_ERROR;
  121.     }
  122.     object = (ClientData) winPtr->pathName;
  123.     } else {
  124.     winPtr = (TkWindow *) clientData;
  125.     object = (ClientData) Tk_GetUid(argv[1]);
  126.     }
  127.  
  128.     if (argc == 4) {
  129.     int append = 0;
  130.     unsigned long mask;
  131.  
  132.     if (argv[3][0] == 0) {
  133.         return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
  134.             object, argv[2]);
  135.     }
  136.     if (argv[3][0] == '+') {
  137.         argv[3]++;
  138.         append = 1;
  139.     }
  140.     mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
  141.         object, argv[2], argv[3], append);
  142.     if (mask == 0) {
  143.         return TCL_ERROR;
  144.     }
  145.     } else if (argc == 3) {
  146.     char *command;
  147.  
  148.     command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
  149.         object, argv[2]);
  150.     if (command == NULL) {
  151.         Tcl_ResetResult(interp);
  152.         return TCL_OK;
  153.     }
  154.     interp->result = command;
  155.     } else {
  156.     Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
  157.     }
  158.     return TCL_OK;
  159. }
  160.  
  161. /*
  162.  *----------------------------------------------------------------------
  163.  *
  164.  * TkBindEventProc --
  165.  *
  166.  *    This procedure is invoked by Tk_HandleEvent for each event;  it
  167.  *    causes any appropriate bindings for that event to be invoked.
  168.  *
  169.  * Results:
  170.  *    None.
  171.  *
  172.  * Side effects:
  173.  *    Depends on what bindings have been established with the "bind"
  174.  *    command.
  175.  *
  176.  *----------------------------------------------------------------------
  177.  */
  178.  
  179. void
  180. TkBindEventProc(winPtr, eventPtr)
  181.     TkWindow *winPtr;            /* Pointer to info about window. */
  182.     XEvent *eventPtr;            /* Information about event. */
  183. {
  184. #define MAX_OBJS 20
  185.     ClientData objects[MAX_OBJS], *objPtr;
  186.     static Tk_Uid allUid = NULL;
  187.     TkWindow *topLevPtr;
  188.     int i, count;
  189.     char *p;
  190.     Tcl_HashEntry *hPtr;
  191.  
  192.     if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
  193.     return;
  194.     }
  195.  
  196.     objPtr = objects;
  197.     if (winPtr->numTags != 0) {
  198.     /*
  199.      * Make a copy of the tags for the window, replacing window names
  200.      * with pointers to the pathName from the appropriate window.
  201.      */
  202.  
  203.     if (winPtr->numTags > MAX_OBJS) {
  204.         objPtr = (ClientData *) ckalloc((unsigned)
  205.             (winPtr->numTags * sizeof(ClientData)));
  206.     }
  207.     for (i = 0; i < winPtr->numTags; i++) {
  208.         p = (char *) winPtr->tagPtr[i];
  209.         if (*p == '.') {
  210.         hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
  211.         if (hPtr != NULL) {
  212.             p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;
  213.         } else {
  214.             p = NULL;
  215.         }
  216.         }
  217.         objPtr[i] = (ClientData) p;
  218.     }
  219.     count = winPtr->numTags;
  220.     } else {
  221.     objPtr[0] = (ClientData) winPtr->pathName;
  222.     objPtr[1] = (ClientData) winPtr->classUid;
  223.     for (topLevPtr = winPtr;
  224.         (topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_LEVEL);
  225.         topLevPtr = topLevPtr->parentPtr) {
  226.         /* Empty loop body. */
  227.     }
  228.     if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
  229.         count = 4;
  230.         objPtr[2] = (ClientData) topLevPtr->pathName;
  231.     } else {
  232.         count = 3;
  233.     }
  234.     if (allUid == NULL) {
  235.         allUid = Tk_GetUid("all");
  236.     }
  237.     objPtr[count-1] = (ClientData) allUid;
  238.     }
  239.     Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
  240.         count, objPtr);
  241.     if (objPtr != objects) {
  242.     ckfree((char *) objPtr);
  243.     }
  244. }
  245.  
  246. /*
  247.  *----------------------------------------------------------------------
  248.  *
  249.  * Tk_BindtagsCmd --
  250.  *
  251.  *    This procedure is invoked to process the "bindtags" Tcl command.
  252.  *    See the user documentation for details on what it does.
  253.  *
  254.  * Results:
  255.  *    A standard Tcl result.
  256.  *
  257.  * Side effects:
  258.  *    See the user documentation.
  259.  *
  260.  *----------------------------------------------------------------------
  261.  */
  262.  
  263. int
  264. Tk_BindtagsCmd(clientData, interp, argc, argv)
  265.     ClientData clientData;    /* Main window associated with interpreter. */
  266.     Tcl_Interp *interp;        /* Current interpreter. */
  267.     int argc;            /* Number of arguments. */
  268.     char **argv;        /* Argument strings. */
  269. {
  270.     Tk_Window tkwin = (Tk_Window) clientData;
  271.     TkWindow *winPtr, *winPtr2;
  272.     int i, tagArgc;
  273.     char *p, **tagArgv;
  274.  
  275.     if ((argc < 2) || (argc > 3)) {
  276.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  277.         " window ?tags?\"", (char *) NULL);
  278.     return TCL_ERROR;
  279.     }
  280.     winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
  281.     if (winPtr == NULL) {
  282.     return TCL_ERROR;
  283.     }
  284.     if (argc == 2) {
  285.     if (winPtr->numTags == 0) {
  286.         Tcl_AppendElement(interp, winPtr->pathName);
  287.         Tcl_AppendElement(interp, winPtr->classUid);
  288.         for (winPtr2 = winPtr;
  289.             (winPtr2 != NULL) && !(winPtr2->flags & TK_TOP_LEVEL);
  290.             winPtr2 = winPtr2->parentPtr) {
  291.         /* Empty loop body. */
  292.         }
  293.         if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
  294.         Tcl_AppendElement(interp, winPtr2->pathName);
  295.         }
  296.         Tcl_AppendElement(interp, "all");
  297.     } else {
  298.         for (i = 0; i < winPtr->numTags; i++) {
  299.         Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]);
  300.         }
  301.     }
  302.     return TCL_OK;
  303.     }
  304.     if (winPtr->tagPtr != NULL) {
  305.     TkFreeBindingTags(winPtr);
  306.     }
  307.     if (argv[2][0] == 0) {
  308.     return TCL_OK;
  309.     }
  310.     if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) {
  311.     return TCL_ERROR;
  312.     }
  313.     winPtr->numTags = tagArgc;
  314.     winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
  315.         (tagArgc * sizeof(ClientData)));
  316.     for (i = 0; i < tagArgc; i++) {
  317.     p = tagArgv[i];
  318.     if (p[0] == '.') {
  319.         char *copy;
  320.  
  321.         /*
  322.          * Handle names starting with "." specially: store a malloc'ed
  323.          * string, rather than a Uid;  at event time we'll look up the
  324.          * name in the window table and use the corresponding window,
  325.          * if there is one.
  326.          */
  327.  
  328.         copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
  329.         strcpy(copy, p);
  330.         winPtr->tagPtr[i] = (ClientData) copy;
  331.     } else {
  332.         winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);
  333.     }
  334.     }
  335.     ckfree((char *) tagArgv);
  336.     return TCL_OK;
  337. }
  338.  
  339. /*
  340.  *----------------------------------------------------------------------
  341.  *
  342.  * TkFreeBindingTags --
  343.  *
  344.  *    This procedure is called to free all of the binding tags
  345.  *    associated with a window;  typically it is only invoked where
  346.  *    there are window-specific tags.
  347.  *
  348.  * Results:
  349.  *    None.
  350.  *
  351.  * Side effects:
  352.  *    Any binding tags for winPtr are freed.
  353.  *
  354.  *----------------------------------------------------------------------
  355.  */
  356.  
  357. void
  358. TkFreeBindingTags(winPtr)
  359.     TkWindow *winPtr;        /* Window whose tags are to be released. */
  360. {
  361.     int i;
  362.     char *p;
  363.  
  364.     for (i = 0; i < winPtr->numTags; i++) {
  365.     p = (char *) (winPtr->tagPtr[i]);
  366.     if (*p == '.') {
  367.         /*
  368.          * Names starting with "." are malloced rather than Uids, so
  369.          * they have to be freed.
  370.          */
  371.     
  372.         ckfree(p);
  373.     }
  374.     }
  375.     ckfree((char *) winPtr->tagPtr);
  376.     winPtr->numTags = 0;
  377.     winPtr->tagPtr = NULL;
  378. }
  379.  
  380. /*
  381.  *----------------------------------------------------------------------
  382.  *
  383.  * Tk_DestroyCmd --
  384.  *
  385.  *    This procedure is invoked to process the "destroy" Tcl command.
  386.  *    See the user documentation for details on what it does.
  387.  *
  388.  * Results:
  389.  *    A standard Tcl result.
  390.  *
  391.  * Side effects:
  392.  *    See the user documentation.
  393.  *
  394.  *----------------------------------------------------------------------
  395.  */
  396.  
  397. int
  398. Tk_DestroyCmd(clientData, interp, argc, argv)
  399.     ClientData clientData;        /* Main window associated with
  400.                  * interpreter. */
  401.     Tcl_Interp *interp;        /* Current interpreter. */
  402.     int argc;            /* Number of arguments. */
  403.     char **argv;        /* Argument strings. */
  404. {
  405.     Tk_Window window;
  406.     Tk_Window tkwin = (Tk_Window) clientData;
  407.     int i;
  408.  
  409.     for (i = 1; i < argc; i++) {
  410.     window = Tk_NameToWindow(interp, argv[i], tkwin);
  411.     if (window == NULL) {
  412.         Tcl_ResetResult(interp);
  413.         continue;
  414.     }
  415.     Tk_DestroyWindow(window);
  416.     if (window == tkwin) {
  417.         /*
  418.          * We just deleted the main window for the application! This
  419.          * makes it impossible to do anything more (tkwin isn't
  420.          * valid anymore).
  421.          */
  422.  
  423.         break;
  424.      }
  425.     }
  426.     return TCL_OK;
  427. }
  428.  
  429. /*
  430.  *----------------------------------------------------------------------
  431.  *
  432.  * Tk_LowerCmd --
  433.  *
  434.  *    This procedure is invoked to process the "lower" Tcl command.
  435.  *    See the user documentation for details on what it does.
  436.  *
  437.  * Results:
  438.  *    A standard Tcl result.
  439.  *
  440.  * Side effects:
  441.  *    See the user documentation.
  442.  *
  443.  *----------------------------------------------------------------------
  444.  */
  445.  
  446.     /* ARGSUSED */
  447. int
  448. Tk_LowerCmd(clientData, interp, argc, argv)
  449.     ClientData clientData;    /* Main window associated with
  450.                  * interpreter. */
  451.     Tcl_Interp *interp;        /* Current interpreter. */
  452.     int argc;            /* Number of arguments. */
  453.     char **argv;        /* Argument strings. */
  454. {
  455.     Tk_Window main = (Tk_Window) clientData;
  456.     Tk_Window tkwin, other;
  457.  
  458.     if ((argc != 2) && (argc != 3)) {
  459.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  460.         argv[0], " window ?belowThis?\"", (char *) NULL);
  461.     return TCL_ERROR;
  462.     }
  463.  
  464.     tkwin = Tk_NameToWindow(interp, argv[1], main);
  465.     if (tkwin == NULL) {
  466.     return TCL_ERROR;
  467.     }
  468.     if (argc == 2) {
  469.     other = NULL;
  470.     } else {
  471.     other = Tk_NameToWindow(interp, argv[2], main);
  472.     if (other == NULL) {
  473.         return TCL_ERROR;
  474.     }
  475.     }
  476.     if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
  477.     Tcl_AppendResult(interp, "can't lower \"", argv[1], "\" below \"",
  478.         argv[2], "\"", (char *) NULL);
  479.     return TCL_ERROR;
  480.     }
  481.     return TCL_OK;
  482. }
  483.  
  484. /*
  485.  *----------------------------------------------------------------------
  486.  *
  487.  * Tk_RaiseCmd --
  488.  *
  489.  *    This procedure is invoked to process the "raise" Tcl command.
  490.  *    See the user documentation for details on what it does.
  491.  *
  492.  * Results:
  493.  *    A standard Tcl result.
  494.  *
  495.  * Side effects:
  496.  *    See the user documentation.
  497.  *
  498.  *----------------------------------------------------------------------
  499.  */
  500.  
  501.     /* ARGSUSED */
  502. int
  503. Tk_RaiseCmd(clientData, interp, argc, argv)
  504.     ClientData clientData;    /* Main window associated with
  505.                  * interpreter. */
  506.     Tcl_Interp *interp;        /* Current interpreter. */
  507.     int argc;            /* Number of arguments. */
  508.     char **argv;        /* Argument strings. */
  509. {
  510.     Tk_Window main = (Tk_Window) clientData;
  511.     Tk_Window tkwin, other;
  512.  
  513.     if ((argc != 2) && (argc != 3)) {
  514.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  515.         argv[0], " window ?aboveThis?\"", (char *) NULL);
  516.     return TCL_ERROR;
  517.     }
  518.  
  519.     tkwin = Tk_NameToWindow(interp, argv[1], main);
  520.     if (tkwin == NULL) {
  521.     return TCL_ERROR;
  522.     }
  523.     if (argc == 2) {
  524.     other = NULL;
  525.     } else {
  526.     other = Tk_NameToWindow(interp, argv[2], main);
  527.     if (other == NULL) {
  528.         return TCL_ERROR;
  529.     }
  530.     }
  531.     if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
  532.     Tcl_AppendResult(interp, "can't raise \"", argv[1], "\" above \"",
  533.         argv[2], "\"", (char *) NULL);
  534.     return TCL_ERROR;
  535.     }
  536.     return TCL_OK;
  537. }
  538.  
  539. /*
  540.  *----------------------------------------------------------------------
  541.  *
  542.  * Tk_TkObjCmd --
  543.  *
  544.  *    This procedure is invoked to process the "tk" Tcl command.
  545.  *    See the user documentation for details on what it does.
  546.  *
  547.  * Results:
  548.  *    A standard Tcl result.
  549.  *
  550.  * Side effects:
  551.  *    See the user documentation.
  552.  *
  553.  *----------------------------------------------------------------------
  554.  */
  555.  
  556. int
  557. Tk_TkObjCmd(clientData, interp, objc, objv)
  558.     ClientData clientData;    /* Main window associated with interpreter. */
  559.     Tcl_Interp *interp;        /* Current interpreter. */
  560.     int objc;            /* Number of arguments. */
  561.     Tcl_Obj *CONST objv[];    /* Argument objects. */
  562. {
  563.     int index;
  564.     Tk_Window tkwin;
  565.     static char *optionStrings[] = {
  566.     "appname",    "scaling",    NULL
  567.     };
  568.     enum options {
  569.     TK_APPNAME,    TK_SCALING
  570.     };
  571.  
  572.     tkwin = (Tk_Window) clientData;
  573.  
  574.     if (objc < 2) {
  575.     Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
  576.     return TCL_ERROR;
  577.     }
  578.     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
  579.         &index) != TCL_OK) {
  580.     return TCL_ERROR;
  581.     }
  582.  
  583.     switch ((enum options) index) {
  584.         case TK_APPNAME: {
  585.         TkWindow *winPtr;
  586.         char *string;
  587.  
  588.         winPtr = (TkWindow *) tkwin;
  589.  
  590.         if (objc > 3) {
  591.             Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
  592.         return TCL_ERROR;
  593.         }
  594.         if (objc == 3) {
  595.         string = Tcl_GetStringFromObj(objv[2], NULL);
  596.         winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
  597.         }
  598.         Tcl_SetStringObj(Tcl_GetObjResult(interp), winPtr->nameUid, -1);
  599.         break;
  600.     }
  601.     case TK_SCALING: {
  602.         Screen *screenPtr;
  603.         int skip, width, height;
  604.         double d;
  605.         
  606.         screenPtr = Tk_Screen(tkwin);
  607.  
  608.         skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
  609.         if (skip < 0) {
  610.         return TCL_ERROR;
  611.         }
  612.         if (objc - skip == 2) {
  613.         d = 25.4 / 72;
  614.         d *= WidthOfScreen(screenPtr);
  615.         d /= WidthMMOfScreen(screenPtr);
  616.         Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
  617.         } else if (objc - skip == 3) {
  618.         if (Tcl_GetDoubleFromObj(interp, objv[2 + skip], &d) != TCL_OK) {
  619.             return TCL_ERROR;
  620.         }
  621.         d = (25.4 / 72) / d;
  622.         width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
  623.         if (width <= 0) {
  624.             width = 1;
  625.         }
  626.         height = (int) (d * HeightOfScreen(screenPtr) + 0.5); 
  627.         if (height <= 0) {
  628.             height = 1;
  629.         }
  630.         WidthMMOfScreen(screenPtr) = width;
  631.         HeightMMOfScreen(screenPtr) = height;
  632.         } else {
  633.         Tcl_WrongNumArgs(interp, 2, objv,
  634.             "?-displayof window? ?factor?");
  635.         return TCL_ERROR;
  636.         }
  637.         break;
  638.     }
  639.     }
  640.     return TCL_OK;
  641. }
  642.  
  643. /*
  644.  *----------------------------------------------------------------------
  645.  *
  646.  * Tk_TkwaitCmd --
  647.  *
  648.  *    This procedure is invoked to process the "tkwait" Tcl command.
  649.  *    See the user documentation for details on what it does.
  650.  *
  651.  * Results:
  652.  *    A standard Tcl result.
  653.  *
  654.  * Side effects:
  655.  *    See the user documentation.
  656.  *
  657.  *----------------------------------------------------------------------
  658.  */
  659.  
  660.     /* ARGSUSED */
  661. int
  662. Tk_TkwaitCmd(clientData, interp, argc, argv)
  663.     ClientData clientData;    /* Main window associated with
  664.                  * interpreter. */
  665.     Tcl_Interp *interp;        /* Current interpreter. */
  666.     int argc;            /* Number of arguments. */
  667.     char **argv;        /* Argument strings. */
  668. {
  669.     Tk_Window tkwin = (Tk_Window) clientData;
  670.     int c, done;
  671.     size_t length;
  672.  
  673.     if (argc != 3) {
  674.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  675.         argv[0], " variable|visibility|window name\"", (char *) NULL);
  676.     return TCL_ERROR;
  677.     }
  678.     c = argv[1][0];
  679.     length = strlen(argv[1]);
  680.     if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
  681.         && (length >= 2)) {
  682.     if (Tcl_TraceVar(interp, argv[2],
  683.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  684.         WaitVariableProc, (ClientData) &done) != TCL_OK) {
  685.         return TCL_ERROR;
  686.     }
  687.     done = 0;
  688.     while (!done) {
  689.         Tcl_DoOneEvent(0);
  690.     }
  691.     Tcl_UntraceVar(interp, argv[2],
  692.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  693.         WaitVariableProc, (ClientData) &done);
  694.     } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0)
  695.         && (length >= 2)) {
  696.     Tk_Window window;
  697.  
  698.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  699.     if (window == NULL) {
  700.         return TCL_ERROR;
  701.     }
  702.     Tk_CreateEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
  703.         WaitVisibilityProc, (ClientData) &done);
  704.     done = 0;
  705.     while (!done) {
  706.         Tcl_DoOneEvent(0);
  707.     }
  708.     if (done != 1) {
  709.         /*
  710.          * Note that we do not delete the event handler because it
  711.          * was deleted automatically when the window was destroyed.
  712.          */
  713.  
  714.         Tcl_ResetResult(interp);
  715.         Tcl_AppendResult(interp, "window \"", argv[2],
  716.             "\" was deleted before its visibility changed",
  717.             (char *) NULL);
  718.         return TCL_ERROR;
  719.     }
  720.     Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
  721.         WaitVisibilityProc, (ClientData) &done);
  722.     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
  723.     Tk_Window window;
  724.  
  725.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  726.     if (window == NULL) {
  727.         return TCL_ERROR;
  728.     }
  729.     Tk_CreateEventHandler(window, StructureNotifyMask,
  730.         WaitWindowProc, (ClientData) &done);
  731.     done = 0;
  732.     while (!done) {
  733.         Tcl_DoOneEvent(0);
  734.     }
  735.     /*
  736.      * Note:  there's no need to delete the event handler.  It was
  737.      * deleted automatically when the window was destroyed.
  738.      */
  739.     } else {
  740.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  741.         "\": must be variable, visibility, or window", (char *) NULL);
  742.     return TCL_ERROR;
  743.     }
  744.  
  745.     /*
  746.      * Clear out the interpreter's result, since it may have been set
  747.      * by event handlers.
  748.      */
  749.  
  750.     Tcl_ResetResult(interp);
  751.     return TCL_OK;
  752. }
  753.  
  754.     /* ARGSUSED */
  755. static char *
  756. WaitVariableProc(clientData, interp, name1, name2, flags)
  757.     ClientData clientData;    /* Pointer to integer to set to 1. */
  758.     Tcl_Interp *interp;        /* Interpreter containing variable. */
  759.     char *name1;        /* Name of variable. */
  760.     char *name2;        /* Second part of variable name. */
  761.     int flags;            /* Information about what happened. */
  762. {
  763.     int *donePtr = (int *) clientData;
  764.  
  765.     *donePtr = 1;
  766.     return (char *) NULL;
  767. }
  768.  
  769.     /*ARGSUSED*/
  770. static void
  771. WaitVisibilityProc(clientData, eventPtr)
  772.     ClientData clientData;    /* Pointer to integer to set to 1. */
  773.     XEvent *eventPtr;        /* Information about event (not used). */
  774. {
  775.     int *donePtr = (int *) clientData;
  776.  
  777.     if (eventPtr->type == VisibilityNotify) {
  778.     *donePtr = 1;
  779.     }
  780.     if (eventPtr->type == DestroyNotify) {
  781.     *donePtr = 2;
  782.     }
  783. }
  784.  
  785. static void
  786. WaitWindowProc(clientData, eventPtr)
  787.     ClientData clientData;    /* Pointer to integer to set to 1. */
  788.     XEvent *eventPtr;        /* Information about event. */
  789. {
  790.     int *donePtr = (int *) clientData;
  791.  
  792.     if (eventPtr->type == DestroyNotify) {
  793.     *donePtr = 1;
  794.     }
  795. }
  796.  
  797. /*
  798.  *----------------------------------------------------------------------
  799.  *
  800.  * Tk_UpdateCmd --
  801.  *
  802.  *    This procedure is invoked to process the "update" Tcl command.
  803.  *    See the user documentation for details on what it does.
  804.  *
  805.  * Results:
  806.  *    A standard Tcl result.
  807.  *
  808.  * Side effects:
  809.  *    See the user documentation.
  810.  *
  811.  *----------------------------------------------------------------------
  812.  */
  813.  
  814.     /* ARGSUSED */
  815. int
  816. Tk_UpdateCmd(clientData, interp, argc, argv)
  817.     ClientData clientData;    /* Main window associated with
  818.                  * interpreter. */
  819.     Tcl_Interp *interp;        /* Current interpreter. */
  820.     int argc;            /* Number of arguments. */
  821.     char **argv;        /* Argument strings. */
  822. {
  823.     int flags;
  824.     TkDisplay *dispPtr;
  825.  
  826.     if (argc == 1) {
  827.     flags = TCL_DONT_WAIT;
  828.     } else if (argc == 2) {
  829.     if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
  830.         Tcl_AppendResult(interp, "bad option \"", argv[1],
  831.             "\": must be idletasks", (char *) NULL);
  832.         return TCL_ERROR;
  833.     }
  834.     flags = TCL_IDLE_EVENTS;
  835.     } else {
  836.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  837.         argv[0], " ?idletasks?\"", (char *) NULL);
  838.     return TCL_ERROR;
  839.     }
  840.  
  841.     /*
  842.      * Handle all pending events, sync all displays, and repeat over
  843.      * and over again until all pending events have been handled.
  844.      * Special note:  it's possible that the entire application could
  845.      * be destroyed by an event handler that occurs during the update.
  846.      * Thus, don't use any information from tkwin after calling
  847.      * Tcl_DoOneEvent.
  848.      */
  849.  
  850.     while (1) {
  851.     while (Tcl_DoOneEvent(flags) != 0) {
  852.         /* Empty loop body */
  853.     }
  854.     for (dispPtr = tkDisplayList; dispPtr != NULL;
  855.         dispPtr = dispPtr->nextPtr) {
  856.         XSync(dispPtr->display, False);
  857.     }
  858.     if (Tcl_DoOneEvent(flags) == 0) {
  859.         break;
  860.     }
  861.     }
  862.  
  863.     /*
  864.      * Must clear the interpreter's result because event handlers could
  865.      * have executed commands.
  866.      */
  867.  
  868.     Tcl_ResetResult(interp);
  869.     return TCL_OK;
  870. }
  871.  
  872. /*
  873.  *----------------------------------------------------------------------
  874.  *
  875.  * Tk_WinfoObjCmd --
  876.  *
  877.  *    This procedure is invoked to process the "winfo" Tcl command.
  878.  *    See the user documentation for details on what it does.
  879.  *
  880.  * Results:
  881.  *    A standard Tcl result.
  882.  *
  883.  * Side effects:
  884.  *    See the user documentation.
  885.  *
  886.  *----------------------------------------------------------------------
  887.  */
  888.  
  889. int
  890. Tk_WinfoObjCmd(clientData, interp, objc, objv)
  891.     ClientData clientData;    /* Main window associated with
  892.                  * interpreter. */
  893.     Tcl_Interp *interp;        /* Current interpreter. */
  894.     int objc;            /* Number of arguments. */
  895.     Tcl_Obj *CONST objv[];    /* Argument objects. */
  896. {
  897.     int index, x, y, width, height, useX, useY, class, skip;
  898.     char buf[128];
  899.     char *string;
  900.     TkWindow *winPtr;
  901.     Tk_Window tkwin;
  902.  
  903.     static TkStateMap visualMap[] = {
  904.     {PseudoColor,    "pseudocolor"},
  905.     {GrayScale,    "grayscale"},
  906.     {DirectColor,    "directcolor"},
  907.     {TrueColor,    "truecolor"},
  908.     {StaticColor,    "staticcolor"},
  909.     {StaticGray,    "staticgray"},
  910.     {-1,        NULL}
  911.     };
  912.     static char *optionStrings[] = {
  913.     "cells",    "children",    "class",    "colormapfull",
  914.     "depth",    "geometry",    "height",    "id",
  915.     "ismapped",    "manager",    "name",        "parent",
  916.     "pointerx",    "pointery",    "pointerxy",    "reqheight",
  917.     "reqwidth",    "rootx",    "rooty",    "screen",
  918.     "screencells",    "screendepth",    "screenheight",    "screenwidth",
  919.     "screenmmheight","screenmmwidth","screenvisual","server",
  920.     "toplevel",    "viewable",    "visual",    "visualid",
  921.     "vrootheight",    "vrootwidth",    "vrootx",    "vrooty",
  922.     "width",    "x",        "y",
  923.     
  924.     "atom",        "atomname",    "containing",    "interps",
  925.     "pathname",
  926.  
  927.     "exists",    "fpixels",    "pixels",    "rgb",
  928.     "visualsavailable",
  929.  
  930.     NULL
  931.     };
  932.     enum options {
  933.     WIN_CELLS,    WIN_CHILDREN,    WIN_CLASS,    WIN_COLORMAPFULL,
  934.     WIN_DEPTH,    WIN_GEOMETRY,    WIN_HEIGHT,    WIN_ID,
  935.     WIN_ISMAPPED,    WIN_MANAGER,    WIN_NAME,    WIN_PARENT,
  936.     WIN_POINTERX,    WIN_POINTERY,    WIN_POINTERXY,    WIN_REQHEIGHT,
  937.     WIN_REQWIDTH,    WIN_ROOTX,    WIN_ROOTY,    WIN_SCREEN,
  938.     WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,
  939.     WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,
  940.     WIN_TOPLEVEL,    WIN_VIEWABLE,    WIN_VISUAL,    WIN_VISUALID,
  941.     WIN_VROOTHEIGHT,WIN_VROOTWIDTH,    WIN_VROOTX,    WIN_VROOTY,
  942.     WIN_WIDTH,    WIN_X,        WIN_Y,
  943.     
  944.     WIN_ATOM,    WIN_ATOMNAME,    WIN_CONTAINING,    WIN_INTERPS,
  945.     WIN_PATHNAME,
  946.  
  947.     WIN_EXISTS,    WIN_FPIXELS,    WIN_PIXELS,    WIN_RGB,
  948.     WIN_VISUALSAVAILABLE
  949.     };
  950.  
  951.     tkwin = (Tk_Window) clientData;
  952.     
  953.     if (objc < 2) {
  954.     Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
  955.     return TCL_ERROR;
  956.     }
  957.     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
  958.         &index) != TCL_OK) {
  959.     return TCL_ERROR;
  960.     }
  961.  
  962.     if (index < WIN_ATOM) {
  963.     if (objc != 3) {
  964.         Tcl_WrongNumArgs(interp, 2, objv, "window");
  965.         return TCL_ERROR;
  966.     }
  967.     string = Tcl_GetStringFromObj(objv[2], NULL);
  968.     tkwin = Tk_NameToWindow(interp, string, tkwin);
  969.     if (tkwin == NULL) {
  970.         return TCL_ERROR;
  971.     }
  972.     }
  973.     winPtr = (TkWindow *) tkwin;
  974.  
  975.     switch ((enum options) index) {
  976.     case WIN_CELLS: {
  977.         Tcl_ResetResult(interp);
  978.         Tcl_SetIntObj(Tcl_GetObjResult(interp),
  979.             Tk_Visual(tkwin)->map_entries);
  980.         break;
  981.     }
  982.     case WIN_CHILDREN: {
  983.         Tcl_Obj *strPtr;
  984.  
  985.         Tcl_ResetResult(interp);
  986.         winPtr = winPtr->childList;
  987.         for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
  988.         strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
  989.         Tcl_ListObjAppendElement(NULL,
  990.              Tcl_GetObjResult(interp), strPtr);
  991.         }
  992.         break;
  993.     }
  994.     case WIN_CLASS: {
  995.         Tcl_ResetResult(interp);
  996.         Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Class(tkwin), -1);
  997.         break;
  998.     }
  999.     case WIN_COLORMAPFULL: {
  1000.         Tcl_ResetResult(interp);
  1001.         Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
  1002.             TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
  1003.         break;
  1004.     }
  1005.     case WIN_DEPTH: {
  1006.         Tcl_ResetResult(interp);
  1007.         Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Depth(tkwin));
  1008.         break;
  1009.     }
  1010.     case WIN_GEOMETRY: {
  1011.         Tcl_ResetResult(interp);
  1012.         sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
  1013.             Tk_X(tkwin), Tk_Y(tkwin));
  1014.         Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
  1015.         break;
  1016.     }
  1017.     case WIN_HEIGHT: {
  1018.         Tcl_ResetResult(interp);
  1019.         Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Height(tkwin));
  1020.         break;
  1021.     }
  1022.     case WIN_ID: {
  1023.         Tk_MakeWindowExist(tkwin);
  1024.         TkpPrintWindowId(buf, Tk_WindowId(tkwin));
  1025.         Tcl_ResetResult(interp);
  1026.         Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
  1027.         break;
  1028.     }
  1029.     case WIN_ISMAPPED: {
  1030.         Tcl_ResetResult(interp);
  1031.         Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
  1032.             (int) Tk_IsMapped(tkwin));
  1033.         break;
  1034.     }
  1035.     case WIN_MANAGER: {
  1036.         Tcl_ResetResult(interp);
  1037.         if (winPtr->geomMgrPtr != NULL) {
  1038.         Tcl_SetStringObj(Tcl_GetObjResult(interp),
  1039.                 winPtr->geomMgrPtr->name, -1);
  1040.         }
  1041.         break;
  1042.     }
  1043.     case WIN_NAME: {
  1044.         Tcl_ResetResult(interp);
  1045.         Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Name(tkwin), -1);
  1046.         break;
  1047.     }
  1048.     case WIN_PARENT: {
  1049.         Tcl_ResetResult(interp);
  1050.         if (winPtr->parentPtr != NULL) {
  1051.         Tcl_SetStringObj(Tcl_GetObjResult(interp),
  1052.                 winPtr->parentPtr->pathName, -1);
  1053.         }
  1054.         break;
  1055.     }
  1056.     case WIN_POINTERX: {
  1057.         useX = 1;
  1058.         useY = 0;
  1059.         goto pointerxy;
  1060.     }
  1061.     case WIN_POINTERY: {
  1062.         useX = 0;
  1063.         useY = 1;
  1064.         goto pointerxy;
  1065.     }
  1066.     case WIN_POINTERXY: {
  1067.         useX = 1;
  1068.         useY = 1;
  1069.  
  1070.         pointerxy:
  1071.         winPtr = GetToplevel(tkwin);
  1072.         if (winPtr == NULL) {
  1073.         x = -1;
  1074.         y = -1;
  1075.         } else {
  1076.         TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
  1077.         }
  1078.         Tcl_ResetResult(interp);
  1079.         if (useX & useY) {
  1080.         sprintf(buf, "%d %d", x, y);
  1081.         Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
  1082.         } else if (useX) {
  1083.         Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
  1084.         } else {
  1085.         Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
  1086.         }
  1087.         break;
  1088.     }
  1089.     case WIN_REQHEIGHT: {
  1090.         Tcl_ResetResult(interp);
  1091.         Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqHeight(tkwin));
  1092.         break;
  1093.     }
  1094.     case WIN_REQWIDTH: {
  1095.         Tcl_ResetResult(interp);
  1096.         Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqWidth(tkwin));
  1097.         break;
  1098.     }
  1099.     case WIN_ROOTX: {
  1100.         Tk_GetRootCoords(tkwin, &x, &y);
  1101.         Tcl_ResetResult(interp);
  1102.         Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
  1103.         break;
  1104.     }
  1105.     case WIN_ROOTY: {
  1106.         Tk_GetRootCoords(tkwin, &x, &y);
  1107.         Tcl_ResetResult(interp);
  1108.         Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
  1109.         break;
  1110.     }
  1111.     case WIN_SCREEN: {
  1112.         sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
  1113.         Tcl_ResetResult(interp);
  1114.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1115.             Tk_DisplayName(tkwin), ".", buf, NULL);
  1116.         break;
  1117.     }
  1118.     case WIN_SCREENCELLS: {
  1119.         Tcl_ResetResult(interp);
  1120.         Tcl_SetIntObj(Tcl_GetObjResult(interp),
  1121.             CellsOfScreen(Tk_Screen(tkwin)));
  1122.         break;
  1123.     }
  1124.     case WIN_SCREENDEPTH: {
  1125.         Tcl_ResetResult(interp);
  1126.         Tcl_SetIntObj(Tcl_GetObjResult(interp),
  1127.             DefaultDepthOfScreen(Tk_Screen(tkwin)));
  1128.         break;
  1129.     }
  1130.     case WIN_SCREENHEIGHT: {
  1131.         Tcl_ResetResult(interp);
  1132.         Tcl_SetIntObj(Tcl_GetObjResult(interp),
  1133.             HeightOfScreen(Tk_Screen(tkwin)));
  1134.         break;
  1135.     }
  1136.     case WIN_SCREENWIDTH: {
  1137.         Tcl_ResetResult(interp);
  1138.         Tcl_SetIntObj(Tcl_GetObjResult(interp),
  1139.             WidthOfScreen(Tk_Screen(tkwin)));
  1140.         break;
  1141.     }
  1142.     case WIN_SCREENMMHEIGHT: {
  1143.         Tcl_ResetResult(interp);
  1144.         Tcl_SetIntObj(Tcl_GetObjResult(interp),
  1145.             HeightMMOfScreen(Tk_Screen(tkwin)));
  1146.         break;
  1147.     }
  1148.     case WIN_SCREENMMWIDTH: {
  1149.         Tcl_ResetResult(interp);
  1150.         Tcl_SetIntObj(Tcl_GetObjResult(interp),
  1151.             WidthMMOfScreen(Tk_Screen(tkwin)));
  1152.         break;
  1153.     }
  1154.     case WIN_SCREENVISUAL: {
  1155.         class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
  1156.         goto visual;
  1157.     }
  1158.     case WIN_SERVER: {
  1159.         TkGetServerInfo(interp, tkwin);
  1160.         break;
  1161.     }
  1162.     case WIN_TOPLEVEL: {
  1163.         winPtr = GetToplevel(tkwin);
  1164.         if (winPtr != NULL) {
  1165.         Tcl_ResetResult(interp);
  1166.         Tcl_SetStringObj(Tcl_GetObjResult(interp),
  1167.             winPtr->pathName, -1);
  1168.         }
  1169.         break;
  1170.     }
  1171.     case WIN_VIEWABLE: {
  1172.         int viewable;
  1173.  
  1174.         viewable = 0;
  1175.         for ( ; ; winPtr = winPtr->parentPtr) {
  1176.         if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
  1177.             break;
  1178.         }
  1179.         if (winPtr->flags & TK_TOP_LEVEL) {
  1180.             viewable = 1;
  1181.             break;
  1182.         }
  1183.         }
  1184.         Tcl_ResetResult(interp);
  1185.         Tcl_SetBooleanObj(Tcl_GetObjResult(interp), viewable);
  1186.         break;
  1187.     }
  1188.     case WIN_VISUAL: {
  1189.         class = Tk_Visual(tkwin)->class;
  1190.  
  1191.         visual:
  1192.         string = TkFindStateString(visualMap, class);
  1193.         if (string == NULL) {
  1194.         string = "unknown";
  1195.         }
  1196.         Tcl_ResetResult(interp);
  1197.         Tcl_SetStringObj(Tcl_GetObjResult(interp), string, -1);
  1198.         break;
  1199.     }
  1200.     case WIN_VISUALID: {
  1201.         Tcl_ResetResult(interp);
  1202.         sprintf(buf, "0x%x",
  1203.             (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
  1204.         Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
  1205.         break;
  1206.     }
  1207.     case WIN_VROOTHEIGHT: {
  1208.         Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
  1209.         Tcl_ResetResult(interp);
  1210.         Tcl_SetIntObj(Tcl_GetObjResult(interp), height);
  1211.         break;
  1212.     }
  1213.     case WIN_VROOTWIDTH: {
  1214.         Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
  1215.         Tcl_ResetResult(interp);
  1216.         Tcl_SetIntObj(Tcl_GetObjResult(interp), width);
  1217.         break;
  1218.     }
  1219.     case WIN_VROOTX: {
  1220.         Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
  1221.         Tcl_ResetResult(interp);
  1222.         Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
  1223.         break;
  1224.     }
  1225.     case WIN_VROOTY: {
  1226.         Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
  1227.         Tcl_ResetResult(interp);
  1228.         Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
  1229.         break;
  1230.     }
  1231.     case WIN_WIDTH: {
  1232.         Tcl_ResetResult(interp);
  1233.         Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Width(tkwin));
  1234.         break;
  1235.     }
  1236.     case WIN_X: {
  1237.         Tcl_ResetResult(interp);
  1238.         Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_X(tkwin));
  1239.         break;
  1240.     }
  1241.     case WIN_Y: {
  1242.         Tcl_ResetResult(interp);
  1243.         Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Y(tkwin));
  1244.         break;
  1245.     }
  1246.  
  1247.     /*
  1248.      * Uses -displayof.
  1249.      */
  1250.      
  1251.     case WIN_ATOM: {
  1252.         skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
  1253.         if (skip < 0) {
  1254.         return TCL_ERROR;
  1255.         }
  1256.         if (objc - skip != 3) {
  1257.             Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
  1258.         return TCL_ERROR;
  1259.         }
  1260.         objv += skip;
  1261.         string = Tcl_GetStringFromObj(objv[2], NULL);
  1262.         Tcl_ResetResult(interp);
  1263.         Tcl_SetLongObj(Tcl_GetObjResult(interp),
  1264.             (long) Tk_InternAtom(tkwin, string));
  1265.         break;
  1266.     }
  1267.     case WIN_ATOMNAME: {
  1268.         char *name;
  1269.         long id;
  1270.         
  1271.         skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
  1272.         if (skip < 0) {
  1273.         return TCL_ERROR;
  1274.         }
  1275.         if (objc - skip != 3) {
  1276.         Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
  1277.         return TCL_ERROR;
  1278.         }
  1279.         objv += skip;
  1280.         if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
  1281.         return TCL_ERROR;
  1282.         }
  1283.         Tcl_ResetResult(interp);
  1284.         name = Tk_GetAtomName(tkwin, (Atom) id);
  1285.         if (strcmp(name, "?bad atom?") == 0) {
  1286.         string = Tcl_GetStringFromObj(objv[2], NULL);
  1287.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1288.             "no atom exists with id \"", string, "\"", NULL);
  1289.         return TCL_ERROR;
  1290.         }
  1291.         Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
  1292.         break;
  1293.     }
  1294.     case WIN_CONTAINING: {
  1295.         skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
  1296.         if (skip < 0) {
  1297.         return TCL_ERROR;
  1298.         }
  1299.         if (objc - skip != 4) {
  1300.         Tcl_WrongNumArgs(interp, 2, objv,
  1301.             "?-displayof window? rootX rootY");
  1302.         return TCL_ERROR;
  1303.         }
  1304.         objv += skip;
  1305.         string = Tcl_GetStringFromObj(objv[2], NULL);
  1306.         if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {
  1307.         return TCL_ERROR;
  1308.         }
  1309.         string = Tcl_GetStringFromObj(objv[3], NULL);
  1310.         if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
  1311.         return TCL_ERROR;
  1312.         }
  1313.         tkwin = Tk_CoordsToWindow(x, y, tkwin);
  1314.         if (tkwin != NULL) {
  1315.         Tcl_ResetResult(interp);
  1316.         Tcl_SetStringObj(Tcl_GetObjResult(interp),
  1317.             Tk_PathName(tkwin), -1);
  1318.         }
  1319.         break;
  1320.     }
  1321.     case WIN_INTERPS: {
  1322.         int result;
  1323.         
  1324.         skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
  1325.         if (skip < 0) {
  1326.         return TCL_ERROR;
  1327.         }
  1328.         if (objc - skip != 2) {
  1329.         Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
  1330.         return TCL_ERROR;
  1331.         }
  1332.         result = TkGetInterpNames(interp, tkwin);
  1333.         return result;
  1334.     }
  1335.     case WIN_PATHNAME: {
  1336.         int id;
  1337.  
  1338.         skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
  1339.         if (skip < 0) {
  1340.         return TCL_ERROR;
  1341.         }
  1342.         if (objc - skip != 3) {
  1343.         Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
  1344.         return TCL_ERROR;
  1345.         }
  1346.         string = Tcl_GetStringFromObj(objv[2 + skip], NULL);
  1347.         if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
  1348.         return TCL_ERROR;
  1349.         }
  1350.         winPtr = (TkWindow *)
  1351.                 Tk_IdToWindow(Tk_Display(tkwin), (Window) id);
  1352.         if ((winPtr == NULL) ||
  1353.             (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
  1354.         Tcl_ResetResult(interp);
  1355.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1356.             "window id \"", string,
  1357.             "\" doesn't exist in this application", (char *) NULL);
  1358.         return TCL_ERROR;
  1359.         }
  1360.  
  1361.         /*
  1362.          * If the window is a utility window with no associated path
  1363.          * (such as a wrapper window or send communication window), just
  1364.          * return an empty string.
  1365.          */
  1366.  
  1367.         tkwin = (Tk_Window) winPtr;
  1368.         if (Tk_PathName(tkwin) != NULL) {
  1369.         Tcl_ResetResult(interp);
  1370.         Tcl_SetStringObj(Tcl_GetObjResult(interp),
  1371.                 Tk_PathName(tkwin), -1);
  1372.         }
  1373.         break;
  1374.     }
  1375.  
  1376.     /*
  1377.      * objv[3] is window.
  1378.      */
  1379.  
  1380.     case WIN_EXISTS: {
  1381.         int alive;
  1382.  
  1383.         if (objc != 3) {
  1384.         Tcl_WrongNumArgs(interp, 2, objv, "window");
  1385.         return TCL_ERROR;
  1386.         }
  1387.         string = Tcl_GetStringFromObj(objv[2], NULL);
  1388.         winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
  1389.         alive = 1;
  1390.         if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
  1391.         alive = 0;
  1392.         }
  1393.         Tcl_ResetResult(interp); /* clear any error msg */
  1394.         Tcl_SetBooleanObj(Tcl_GetObjResult(interp), alive);
  1395.         break;
  1396.     }
  1397.     case WIN_FPIXELS: {
  1398.         double mm, pixels;
  1399.  
  1400.         if (objc != 4) {
  1401.         Tcl_WrongNumArgs(interp, 2, objv, "window number");
  1402.         return TCL_ERROR;
  1403.         }
  1404.         string = Tcl_GetStringFromObj(objv[2], NULL);
  1405.         tkwin = Tk_NameToWindow(interp, string, tkwin);
  1406.         if (tkwin == NULL) {
  1407.         return TCL_ERROR;
  1408.         }
  1409.         string = Tcl_GetStringFromObj(objv[3], NULL);
  1410.         if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
  1411.         return TCL_ERROR;
  1412.         }
  1413.         pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
  1414.         / WidthMMOfScreen(Tk_Screen(tkwin));
  1415.         Tcl_ResetResult(interp);
  1416.         Tcl_SetDoubleObj(Tcl_GetObjResult(interp), pixels);
  1417.         break;
  1418.     }
  1419.     case WIN_PIXELS: {
  1420.         int pixels;
  1421.         
  1422.         if (objc != 4) {
  1423.         Tcl_WrongNumArgs(interp, 2, objv, "window number");
  1424.         return TCL_ERROR;
  1425.         }
  1426.         string = Tcl_GetStringFromObj(objv[2], NULL);
  1427.         tkwin = Tk_NameToWindow(interp, string, tkwin);
  1428.         if (tkwin == NULL) {
  1429.         return TCL_ERROR;
  1430.         }
  1431.         string = Tcl_GetStringFromObj(objv[3], NULL);
  1432.         if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
  1433.         return TCL_ERROR;
  1434.         }
  1435.         Tcl_ResetResult(interp);
  1436.         Tcl_SetIntObj(Tcl_GetObjResult(interp), pixels);
  1437.         break;
  1438.     }
  1439.     case WIN_RGB: {
  1440.         XColor *colorPtr;
  1441.  
  1442.         if (objc != 4) {
  1443.         Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
  1444.         return TCL_ERROR;
  1445.         }
  1446.         string = Tcl_GetStringFromObj(objv[2], NULL);
  1447.         tkwin = Tk_NameToWindow(interp, string, tkwin);
  1448.         if (tkwin == NULL) {
  1449.         return TCL_ERROR;
  1450.         }
  1451.         string = Tcl_GetStringFromObj(objv[3], NULL);
  1452.         colorPtr = Tk_GetColor(interp, tkwin, string);
  1453.         if (colorPtr == NULL) {
  1454.         return TCL_ERROR;
  1455.         }
  1456.         sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
  1457.             colorPtr->blue);
  1458.         Tk_FreeColor(colorPtr);
  1459.         Tcl_ResetResult(interp);
  1460.         Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
  1461.         break;
  1462.     }
  1463.     case WIN_VISUALSAVAILABLE: {
  1464.         XVisualInfo template, *visInfoPtr;
  1465.         int count, i;
  1466.         char visualIdString[16];
  1467.         int includeVisualId;
  1468.         Tcl_Obj *strPtr;
  1469.  
  1470.         if (objc == 3) {
  1471.         includeVisualId = 0;
  1472.         } else if ((objc == 4)
  1473.             && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),
  1474.                 "includeids") == 0)) {
  1475.         includeVisualId = 1;
  1476.         } else {
  1477.         Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");
  1478.         return TCL_ERROR;
  1479.         }
  1480.  
  1481.         string = Tcl_GetStringFromObj(objv[2], NULL);
  1482.         tkwin = Tk_NameToWindow(interp, string, tkwin); 
  1483.         if (tkwin == NULL) { 
  1484.         return TCL_ERROR; 
  1485.         }
  1486.  
  1487.         template.screen = Tk_ScreenNumber(tkwin);
  1488.         visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
  1489.             &template, &count);
  1490.         Tcl_ResetResult(interp);
  1491.         if (visInfoPtr == NULL) {
  1492.         Tcl_SetStringObj(Tcl_GetObjResult(interp),
  1493.             "can't find any visuals for screen", -1);
  1494.         return TCL_ERROR;
  1495.         }
  1496.         for (i = 0; i < count; i++) {
  1497.         string = TkFindStateString(visualMap, visInfoPtr[i].class);
  1498.         if (string == NULL) {
  1499.             strcpy(buf, "unknown");
  1500.         } else {
  1501.             sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
  1502.         }
  1503.         if (includeVisualId) {
  1504.             sprintf(visualIdString, " 0x%x",
  1505.                 (unsigned int) visInfoPtr[i].visualid);
  1506.             strcat(buf, visualIdString);
  1507.         }
  1508.         strPtr = Tcl_NewStringObj(buf, -1);
  1509.         Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
  1510.                 strPtr);
  1511.         }
  1512.         XFree((char *) visInfoPtr);
  1513.         break;
  1514.     }
  1515.     }
  1516.     return TCL_OK;
  1517. }
  1518.  
  1519. /*
  1520.  *----------------------------------------------------------------------
  1521.  *
  1522.  * TkGetDisplayOf --
  1523.  *
  1524.  *    Parses a "-displayof window" option for various commands.  If
  1525.  *    present, the literal "-displayof" should be in objv[0] and the
  1526.  *    window name in objv[1].
  1527.  *
  1528.  * Results:
  1529.  *    The return value is 0 if the argument strings did not contain
  1530.  *    the "-displayof" option.  The return value is 2 if the
  1531.  *    argument strings contained both the "-displayof" option and
  1532.  *    a valid window name.  Otherwise, the return value is -1 if
  1533.  *    the window name was missing or did not specify a valid window.
  1534.  *
  1535.  *    If the return value was 2, *tkwinPtr is filled with the
  1536.  *    token for the window specified on the command line.  If the
  1537.  *    return value was -1, an error message is left in interp's
  1538.  *    result object.
  1539.  *
  1540.  * Side effects:
  1541.  *    None.
  1542.  *
  1543.  *----------------------------------------------------------------------
  1544.  */
  1545.  
  1546. int
  1547. TkGetDisplayOf(interp, objc, objv, tkwinPtr)
  1548.     Tcl_Interp *interp;        /* Interpreter for error reporting. */
  1549.     int objc;            /* Number of arguments. */
  1550.     Tcl_Obj *CONST objv[];    /* Argument objects. If it is present,
  1551.                  * "-displayof" should be in objv[0] and
  1552.                  * objv[1] the name of a window. */
  1553.     Tk_Window *tkwinPtr;    /* On input, contains main window of
  1554.                  * application associated with interp.  On
  1555.                  * output, filled with window specified as
  1556.                  * option to "-displayof" argument, or
  1557.                  * unmodified if "-displayof" argument was not
  1558.                  * present. */
  1559. {
  1560.     char *string;
  1561.     int length;
  1562.     
  1563.     if (objc < 1) {
  1564.     return 0;
  1565.     }
  1566.     string = Tcl_GetStringFromObj(objv[0], &length);
  1567.     if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) {
  1568.         if (objc < 2) {
  1569.         Tcl_SetStringObj(Tcl_GetObjResult(interp),
  1570.             "value for \"-displayof\" missing", -1);
  1571.         return -1;
  1572.     }
  1573.     string = Tcl_GetStringFromObj(objv[1], NULL);
  1574.     *tkwinPtr = Tk_NameToWindow(interp, string, *tkwinPtr);
  1575.     if (*tkwinPtr == NULL) {
  1576.         return -1;
  1577.     }
  1578.     return 2;
  1579.     }
  1580.     return 0;
  1581. }
  1582.  
  1583. /*
  1584.  *----------------------------------------------------------------------
  1585.  *
  1586.  * TkDeadAppCmd --
  1587.  *
  1588.  *    If an application has been deleted then all Tk commands will be
  1589.  *    re-bound to this procedure.
  1590.  *
  1591.  * Results:
  1592.  *    A standard Tcl error is reported to let the user know that
  1593.  *    the application is dead.
  1594.  *
  1595.  * Side effects:
  1596.  *    See the user documentation.
  1597.  *
  1598.  *----------------------------------------------------------------------
  1599.  */
  1600.  
  1601.     /* ARGSUSED */
  1602. int
  1603. TkDeadAppCmd(clientData, interp, argc, argv)
  1604.     ClientData clientData;    /* Dummy. */
  1605.     Tcl_Interp *interp;        /* Current interpreter. */
  1606.     int argc;            /* Number of arguments. */
  1607.     char **argv;        /* Argument strings. */
  1608. {
  1609.     Tcl_AppendResult(interp, "can't invoke \"", argv[0],
  1610.         "\" command:  application has been destroyed", (char *) NULL);
  1611.     return TCL_ERROR;
  1612. }
  1613.  
  1614. /*
  1615.  *----------------------------------------------------------------------
  1616.  *
  1617.  * GetToplevel --
  1618.  *
  1619.  *    Retrieves the toplevel window which is the nearest ancestor of
  1620.  *    of the specified window.
  1621.  *
  1622.  * Results:
  1623.  *    Returns the toplevel window or NULL if the window has no
  1624.  *    ancestor which is a toplevel.
  1625.  *
  1626.  * Side effects:
  1627.  *    None.
  1628.  *
  1629.  *----------------------------------------------------------------------
  1630.  */
  1631.  
  1632. static TkWindow *
  1633. GetToplevel(tkwin)
  1634.     Tk_Window tkwin;        /* Window for which the toplevel should be
  1635.                  * deterined. */
  1636. {
  1637.      TkWindow *winPtr = (TkWindow *) tkwin;
  1638.  
  1639.      while (!(winPtr->flags & TK_TOP_LEVEL)) {
  1640.      winPtr = winPtr->parentPtr;
  1641.      if (winPtr == NULL) {
  1642.          return NULL;
  1643.      }
  1644.      }
  1645.      return winPtr;
  1646. }
  1647.